home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / docs / winer / dbcreate.bas < prev    next >
Encoding:
BASIC Source File  |  1992-05-13  |  1.8 KB  |  79 lines
  1. '*********** DBCREATE.BAS - creates a DBF file
  2.  
  3. 'Copyright (c) 1992 Ethan Winer
  4.  
  5. DEFINT A-Z
  6.  
  7. '$INCLUDE: 'DBF.BI'
  8. '$INCLUDE: 'DBACCESS.BI'
  9.  
  10. CLS
  11. LOCATE , , 1
  12.  
  13. LINE INPUT "Enter DBF name: "; DBFName$
  14. IF INSTR(DBFName$, ".") = 0 THEN
  15.   DBFName$ = DBFName$ + ".DBF"
  16. END IF
  17.  
  18. DO
  19.   INPUT "Enter number of fields"; TFields
  20.   IF TFields <= 128 THEN EXIT DO
  21.   PRINT "Only 128 fields are allowed"
  22. LOOP
  23.  
  24. REDIM FldStruc(1 TO TFields) AS FieldStruc
  25.  
  26. FOR X = 1 TO TFields
  27.   CLS
  28.   DO
  29.     PRINT "Field #"; X
  30.     LINE INPUT "Enter field name: ", Temp$
  31.     IF LEN(Temp$) <= 10 THEN EXIT DO
  32.     PRINT "Field names are limited to 10 characters"
  33.   LOOP
  34.   FldStruc(X).FName = Temp$
  35.  
  36.   PRINT "Enter field type (Char, Date, Logical, Memo, ";
  37.   PRINT "Numeric (C,D,L,M,N): ";
  38.   DO
  39.     Temp$ = UCASE$(INKEY$)
  40.   LOOP UNTIL INSTR(" CDLMN", Temp$) > 1
  41.   PRINT
  42.   FldStruc(X).FType = Temp$
  43.   FldType = ASC(Temp$)
  44.  
  45.   SELECT CASE FldType
  46.     CASE 67                     'Character
  47.       DO
  48.         INPUT "Enter field length: ", FldStruc(X).FLen
  49.         IF FldStruc(X).FLen <= 255 THEN EXIT DO
  50.         PRINT "Character field limited to 255 characters"
  51.       LOOP
  52.  
  53.     CASE 78                     'Numeric
  54.       DO
  55.         INPUT "Enter field length: ", FldStruc(X).FLen
  56.         IF FldStruc(X).FLen <= 19 THEN EXIT DO
  57.         PRINT "Numeric field limited to 19 characters"
  58.       LOOP
  59.       DO
  60.         INPUT "Enter number of decimal places: ", FldStruc(X).Dec
  61.         IF FldStruc(X).Dec < FldStruc(X).FLen THEN EXIT DO
  62.         PRINT "Too many decimal places"
  63.       LOOP
  64.  
  65.     CASE 76                     'Logical
  66.         FldStruc(X).FLen = 1
  67.  
  68.     CASE 68                     'Date
  69.         FldStruc(X).FLen = 8
  70.      
  71.     CASE 77
  72.         FldStruc(X).FLen = 10
  73.  
  74.     END SELECT
  75. NEXT
  76.  
  77. CALL CreateDBF(DBFName$, FldStruc())
  78. PRINT DBFName$; " created"
  79.